home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt32s1.arc / DOSJUMP.PAS < prev    next >
Pascal/Delphi Source File  |  1985-10-25  |  10KB  |  275 lines
  1. (*----------------------------------------------------------------------*)
  2. (*                      DosJump --- Jump to Dos                         *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. OVERLAY PROCEDURE DosJump( Dos_String : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  DosJump;                                             *)
  10. (*                                                                      *)
  11. (*     Purpose:    Provides facility for jumping to DOS                 *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        DosJump( Dos_String : AnyStr );                               *)
  16. (*                                                                      *)
  17. (*           Dos_String --- DOS command to execute                      *)
  18. (*                                                                      *)
  19. (*     Calls:                                                           *)
  20. (*                                                                      *)
  21. (*        GetComSpec                                                    *)
  22. (*        SubProcess                                                    *)
  23. (*                                                                      *)
  24. (*----------------------------------------------------------------------*)
  25.  
  26. VAR
  27.    I          : INTEGER;
  28.    Local_Save : Saved_Screen_Ptr;
  29.  
  30. { EXEC.PAS version 1.3
  31.  
  32.   This file contains 2 functions for Turbo Pascal that allow you to run other
  33.   programs from within a Turbo program.  The first function, SubProcess,
  34.   actually calls up a different program using MS-DOS call 4BH, EXEC.  The
  35.   second function, GetComSpec, returns the path name of the command
  36.   interpreter, which is necessary to do certain operations.  There is also a
  37.   main program that allows you to test the functions.
  38.  
  39.   Revision history
  40.   ----------------
  41.   Version 1.3 works with MS-DOS 2.0 and up, TURBO PASCAL version 1.0 and up.
  42.   Version 1.2 had a subtle but dangerous bug: I set a variable that was
  43.               addressed relative to BP, using a destroyed BP!
  44.   Version 1.1 didn't work with Turbo 2.0 because I used Turbo 3.0 features
  45.   Version 1.0 only worked with DOS 3.0 due to a subtle bug in DOS 2.x
  46.  
  47.     -  Bela Lubkin
  48.        Borland International Technical Support
  49.        CompuServe 71016,1573
  50. }
  51.  
  52. Type
  53.   Str66=String[66];
  54.   Str255=String[255];
  55.  
  56. Function SubProcess(CommandLine: Str255): Integer;
  57.   { Pass this function a string of the form
  58.       'D:\FULL\PATH\NAME\OF\FILE.TYP parameter1 parameter2 ...'
  59.  
  60.     For example,
  61.       'C:\SYSTEM\CHKDSK.COM'
  62.       'A:\WS.COM DOCUMENT.1'
  63.       'C:\DOS\LINK.EXE TEST;'
  64.       'C:\COMMAND.COM /C COPY *.* B:\BACKUP >FILESCOP.IED'
  65.  
  66.     The third example shows several things.  To do any of the following, you
  67.     must invoke the command processor and let it do the work: redirection;
  68.     piping; path searching; searching for the extension of a program (.COM,
  69.     .EXE, or .BAT); batch files; and internal DOS commands.  The name of the
  70.     command processor file is stored in the DOS environment.  The function
  71.     GetComSpec in this file returns the path name of the command processor.
  72.     Also note that you must use the /C parameter or COMMAND will not work
  73.     correctly.  You can also call COMMAND with no parameters.  This will allow
  74.     the user to use the DOS prompt to run anything (as long as there is enough
  75.     memory).  To get back to your program, he can type the command EXIT.
  76.  
  77.     Actual example:
  78.       I:=SubProcess(GetComSpec+' /C COPY *.* B:\BACKUP >FILESCOP.IED');
  79.  
  80.     The value returned is the result returned by DOS after the EXEC call.  The
  81.     most common values are:
  82.  
  83.        0: Success
  84.        1: Invalid function (should never happen with this routine)
  85.        2: File/path not found
  86.        8: Not enough memory to load program
  87.       10: Bad environment (greater than 32K)
  88.       11: Illegal .EXE file format
  89.  
  90.     If you get any other result, consult an MS-DOS Technical Reference manual.
  91.  
  92.     VERY IMPORTANT NOTE: you MUST use the Options menu of Turbo Pascal to
  93.     restrict the amount of free dynamic memory used by your program.  Only the
  94.     memory that is not used by the heap is available for use by other
  95.     programs. }
  96.  
  97.   Const
  98.     SSSave: Integer=0;
  99.     SPSave: Integer=0;
  100.  
  101.   Var
  102.     Regs: Record Case Integer Of
  103.             1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  104.             2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  105.           End;
  106.     FCB1,FCB2: Array [0..36] Of Byte;
  107.     PathName: Str66;
  108.     CommandTail: Str255;
  109.     ParmTable: Record
  110.                  EnvSeg: Integer;
  111.                  ComLin: ^Integer;
  112.                  FCB1Pr: ^Integer;
  113.                  FCB2Pr: ^Integer;
  114.                End;
  115.     I,RegsFlags: Integer;
  116.  
  117.   Begin
  118.                                    (* Change cursor to block *)
  119.     Regs.Ax := $0100;
  120.     Regs.Cx := $0107;
  121.  
  122.     INTR( $10, Regs );
  123.  
  124.     If Pos(' ',CommandLine)=0 Then
  125.      Begin
  126.       PathName:=CommandLine+#0;
  127.       CommandTail:=^M;
  128.      End
  129.     Else
  130.      Begin
  131.       PathName:=Copy(CommandLine,1,Pos(' ',CommandLine)-1)+#0;
  132.       CommandTail:=Copy(CommandLine,Pos(' ',CommandLine),255)+^M;
  133.      End;
  134.     CommandTail[0]:=Pred(CommandTail[0]);
  135.     With Regs Do
  136.      Begin
  137.       FillChar(FCB1,Sizeof(FCB1),0);
  138.       AX:=$2901;
  139.       DS:=Seg(CommandTail[1]);
  140.       SI:=Ofs(CommandTail[1]);
  141.       ES:=Seg(FCB1);
  142.       DI:=Ofs(FCB1);
  143.       MsDos(Regs); { Create FCB 1 }
  144.       FillChar(FCB2,Sizeof(FCB2),0);
  145.       AX:=$2901;
  146.       ES:=Seg(FCB2);
  147.       DI:=Ofs(FCB2);
  148.       MsDos(Regs); { Create FCB 2 }
  149.       ES:=CSeg;
  150.       BX:=SSeg-CSeg+MemW[CSeg:MemW[CSeg:$0101]+$112];
  151.       AH:=$4A;
  152.       MsDos(Regs); { Deallocate unused memory }
  153.       With ParmTable Do
  154.        Begin
  155.         EnvSeg:=MemW[CSeg:$002C];
  156.         ComLin:=Addr(CommandTail);
  157.         FCB1Pr:=Addr(FCB1);
  158.         FCB2Pr:=Addr(FCB2);
  159.        End;
  160.       InLine($8D/$96/ PathName /$42/  { <DX>:=Ofs(PathName[1]); }
  161.              $8D/$9E/ ParmTable /     { <BX>:=Ofs(ParmTable);   }
  162.              $B8/$00/$4B/             { <AX>:=$4B00;            }
  163.              $1E/$55/                 { Save <DS>, <BP>         }
  164.              $16/$1F/                 { <DS>:=Seg(PathName[1]); }
  165.              $16/$07/                 { <ES>:=Seg(ParmTable);   }
  166.              $2E/$8C/$16/ SSSave /    { Save <SS> in SSSave     }
  167.              $2E/$89/$26/ SPSave /    { Save <SP> in SPSave     }
  168.              $FA/                     { Disable interrupts      }
  169.              $CD/$21/                 { Call MS-DOS             }
  170.              $FA/                     { Disable interrupts      }
  171.              $2E/$8B/$26/ SPSave /    { Restore <SP>            }
  172.              $2E/$8E/$16/ SSSave /    { Restore <SS>            }
  173.              $FB/                     { Enable interrupts       }
  174.              $5D/$1F/                 { Restore <BP>,<DS>       }
  175.              $9C/$8F/$86/ RegsFlags / { Flags:=<CPU flags>      }
  176.              $89/$86/ Regs );         { Regs.AX:=<AX>;          }
  177.       { The messing around with SS and SP is necessary because under DOS 2.x,
  178.         after returning from an EXEC call, ALL registers are destroyed except
  179.         CS and IP!  I wish I'd known that before I released this package the
  180.         first time... }
  181.       If (RegsFlags And 1)<>0 Then SubProcess:=AX
  182.       Else SubProcess:=0;
  183.      End;
  184.                                    (* Change cursor back to underline *)
  185.     Regs.Ax := $0100;
  186.     Regs.Cx := $0607;
  187.  
  188.     INTR( $10, Regs );
  189.  
  190.   End;
  191.  
  192. Function GetComSpec: Str66;
  193.   Type
  194.     Env=Array [0..32767] Of Char;
  195.   Var
  196.     EPtr: ^Env;
  197.     EStr: Str255;
  198.     Done: Boolean;
  199.     I: Integer;
  200.  
  201.   Begin
  202.     EPtr:=Ptr(MemW[CSeg:$002C],0);
  203.     I:=0;
  204.     Done:=False;
  205.     EStr:='';
  206.     Repeat
  207.       If EPtr^[I]=#0 Then
  208.        Begin
  209.         If EPtr^[I+1]=#0 Then Done:=True;
  210.         If Copy(EStr,1,8)='COMSPEC=' Then
  211.          Begin
  212.           GetComSpec:=Copy(EStr,9,100);
  213.           Done:=True;
  214.          End;
  215.         EStr:='';
  216.        End
  217.       Else EStr:=EStr+EPtr^[I];
  218.       I:=I+1;
  219.     Until Done;
  220.   End;
  221.  
  222. BEGIN (* DosJump *)
  223.                                    (* Save screen contents *)
  224.    Save_Screen( Local_Save );
  225.  
  226.    WRITELN;
  227.    WRITELN('Jump to DOS:  Enter EXIT to return to PibTerm');
  228.  
  229.                                    (* Close capture file *)
  230.    IF Capture_On THEN
  231.          (*$I-*)
  232.       CLOSE( Capture_File );
  233.          (*$I+*)
  234.  
  235.    I := Int24Result;
  236.                                    (* Remove Int 24 error handler *)
  237.    Int24OFF;
  238.  
  239.    IF LENGTH( Dos_String ) > 0 THEN
  240.       I := SubProcess( GetComSpec + ' /C ' + Dos_String )
  241.    ELSE
  242.       I := SubProcess( GetComSpec );
  243.  
  244.                                    (* Restore Int24 Error handler *)
  245.    Int24ON;
  246.  
  247.    WRITELN('Back to PibTerm, DOS return code is ',I);
  248.  
  249.                                    (* Reopen capture file for append *)
  250.    IF Capture_On THEN
  251.       BEGIN
  252.  
  253.          ASSIGN( Capture_File , Capture_File_Name );
  254.             (*$I-*)
  255.          APPEND( Capture_File );
  256.             (*$I+*)
  257.  
  258.          IF Int24Result <> 0 THEN
  259.             BEGIN
  260.                WRITELN('Could not re-open capture file ',
  261.                         Capture_File_Name,' for append,');
  262.                WRITELN('Capture option TURNED OFF.');
  263.                Capture_On := FALSE;
  264.                DELAY( One_Second_Delay );
  265.             END;
  266.  
  267.       END;
  268.  
  269.    DELAY( One_Second_Delay );
  270.                                    (* Restore screen contents *)
  271.    Restore_Screen( Local_Save );
  272.    Reset_Global_Colors;
  273.  
  274. END   (* DosJump *);
  275.